home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / tsr.swg / 0006_General Purpose TSR Unit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  38.1 KB  |  813 lines
  1. Unit TSRUnit; {Create TSR Programs With Turbo Pascal 5.0 & TSRUnit}
  2.  
  3. {$B-,F-,I+,R-,S+} {Set Compiler directives to normal values.}
  4.  
  5. Interface {=======================================================}
  6. {
  7. The author and any distributor of this software assume no responsi-
  8. bility For damages resulting from this software or its use due to
  9. errors, omissions, inCompatibility With other software or with
  10. hardware, or misuse; and specifically disclaim any implied warranty
  11. of fitness For any particular purpose or application.
  12. }
  13. Uses Dos, Crt;
  14. Const
  15. {*** Shift key combination codes.                                 }
  16.   AltKey = 8;  CtrlKey = 4;  LeftKey = 2;  RightKey = 1;
  17.  
  18.   TSRVersion : Word = $0204;       {Low Byte.High Byte = 2.04     }
  19.  
  20. Type
  21.   String80  = String[80];
  22.   ChrWords  = Record Case Integer of
  23.                   1: ( W: Word );
  24.                   2: ( C: Char; A: Byte );
  25.               end;
  26.   LineWords = Array[1..80] of ChrWords;
  27.   WordFuncs = Function : Word;
  28.  
  29. Var
  30.   TSRScrPtr : Pointer; {Pointer to saved screen image.            }
  31.   TSRChrPtr : Pointer; {Pointer to first Character to insert.     }
  32.   TSRMode   : Byte;    {Video mode --------- beFore TSR popped up.}
  33.   TSRWidth  : Byte;    {Number of screen columns-- " "    "    " .}
  34.   TSRPage   : Byte;    {Active video page number-- " "    "    " .}
  35.   TSRColumn : Byte;    {Cursor column number ----- " "    "    " .}
  36.   TSRRow    : Byte;    {Cursor row number -------- " "    "    " .}
  37. {
  38. ** Procedure For installing the TSR Program.                      }
  39. Procedure TSRInstall( TSRName : String;   {Name or title For TSR. }
  40.                       TSRFunc : WordFuncs;{Ptr to Function to call}
  41.                       ShiftComb: Byte;    {Hot key--shift key comb}
  42.                       KeyChr   : Char );  {Hot Key--Character key.}
  43. {
  44.   ShiftComb and KeyChr specify the default hot keys For the TSR.
  45.   ShiftComb may be created by adding or oring the Constants AltKey,
  46.   CtrlKey, LeftKey, and RightKey together.  KeyChr may be
  47.   Characters 0-9 and A-Z.
  48.  
  49.   The default hot keys may be overridden when the TSR is installed
  50.   by specifying optional parameters on the command line.  The
  51.   parameter Format is:
  52.                        [/A] [/C] [/R] [/L] [/"[K["]]]
  53.   The square brackets surround optional items--do not include them.
  54.   Any Characters between parameters are ignored. The order of the
  55.   Characters does not matter; however, the shift keys specified are
  56.   cummulative and the last Character key "K" specified is the used.
  57. }
  58. {
  59. ** Functions For checking status of Printer LPT1.                 }
  60. Function PrinterOkay:   Boolean; {Returns True if Printer is okay.}
  61. Function PrinterStatus: Byte;    {Returns status of Printer.
  62.   Definition of status Byte bits (1 & 2 are not used), if set then:
  63.  Bit: -- 7 ---  ---- 6 ----  -- 5 ---  -- 4 ---  -- 3 --  --- 0 ---
  64.       not busy  Acknowledge  No paper  Selected  I/O Err. Timed-out
  65. }
  66. {
  67. ** Routines For obtaining one row of screen Characters.           }
  68. Function ScreenLineStr( Row: Byte ): String80; {Returns Char. str.}
  69. Procedure ScreenLine( Row: Byte; Var Line: LineWords; {Returns    }
  70.                                  Var Words: Byte );   {chr & color}
  71.  
  72. Implementation {==================================================}
  73. Var
  74.   BuffSize, InitCMode : Word;
  75.   NpxFlag             : Boolean;
  76.   Buffer              : Array[0..8191] of Word;
  77.   NpxState            : Array[0..93] of Byte;
  78.   RetrnVal, InitVideo : Byte;
  79.   TheirFunc           : WordFuncs;
  80.  
  81. Const    {offsets to items contained in Procedure Asm.            }
  82.   UnSafe = 0;    Flg   = 1;     Key     = 2;     Shft  = 3;
  83.   Stkofs = 4;    StkSs = 6;     DosSp   = 8;     DosSs = 10;
  84.   Prev  = 12;    Flg9  = 13;    InsNumb = 14;
  85.   Dos21 = $10;         Dos25  = Dos21+4;      Dos26  = Dos25+4;
  86.   Bios9 = Dos26+4;     Bios16 = Bios9+4;      DosTab = Bios16+4;
  87.   Our21 = DosTab+99;   Our25  = Our21+51;     Our26  = Our25+27;
  88.   Our09 = Our26+27;    Our16  = Our09+127+8;  InsChr = Our16+180-8;
  89.   PopUp = InsChr+4;
  90.  
  91. Procedure Asm1; {Inline code--data storage and intercept routines. }
  92. INTERRUPT;
  93. begin
  94. Inline(
  95. {***  Storage For interrupt vectors.                              }
  96.       {Dos21:  }  >0/>0/    {Dos func. intr vector.               }
  97.       {Dos25:  }  >0/>0/    {Dos abs. disk read intr. vector.     }
  98.       {Dos26:  }  >0/>0/    {Dos abs. sector Write intr.vector.   }
  99.       {Bios9:  }  >0/>0/    {BIOS key stroke intr. vector.        }
  100.       {Bios16: }  >0/>0/    {BIOS buffered keybd. input intr.vect.}
  101.  
  102.       {DosTab: Array[0..98] of Byte = {Non-reetrant Dos Functions.}
  103.       0/0/0/0/0/0/0/0/  0/0/0/0/0/1/1/1/  1/1/1/1/1/1/1/1/
  104.       1/1/1/1/1/1/1/1/  1/1/1/1/1/1/0/1/  1/1/1/1/1/1/1/0/
  105.       1/0/0/0/0/0/1/1/  1/1/1/1/1/1/1/1/  1/1/1/1/1/1/1/1/
  106.       0/0/0/0/0/0/1/1/  0/0/0/0/1/0/1/1/  0/1/1/1/1/0/0/0/  0/0/0/
  107.  
  108. {*** OurIntr21 ******* Intercept routine For Dos Function Intr.***}
  109. {  0} $9C/               { PUSHF            ;Save flags.          }
  110. {  1} $FB/               { STI              ;Enable interrupts.   }
  111. {  2} $80/$FC/$63/       { CMP  AH,63H      ;Assume unsafe if new }
  112. {  5} $73/<22-7/         { JNB  IncF        ;Function--skip table.}
  113. {  7} $50/               { PUSH AX          ;Save Registers.      }
  114. {  8} $53/               { PUSH BX          ;Load offset to table.}
  115. {  9} $BB/>DosTab/       { MOV  BX,[DosTab]                       }
  116. { 12} $8A/$C4/           { MOV  AL,AH       ;Load table entry     }
  117. { 14} $2E/               { CS:              ;index.               }
  118. { 15} $D7/               { XLAT             ;Get value from table.}
  119. { 16} $3C/$00/           { CMP  AL,0        ;if True then set flag}
  120. { 18} $5B/               { POP  BX          ;Restore Registers.   }
  121. { 19} $58/               { POP  AX          ;                     }
  122. { 20} $74/$17/           { JZ   JmpDos21    ;Jump to orig. intr.  }
  123. { 22} $2E/          {IncF: CS:              ;                     }
  124. { 23} $FE/$06/>UnSafe/   { inC  [UnSafe]    ;Set UnSafe flag.     }
  125. { 27} $9D/               { POPF             ;Restore flags.       }
  126. { 28} $9C/               { PUSHF            ;                     }
  127. { 29} $2E/               { CS:              ;                     }
  128. { 30} $FF/$1E/>Dos21/    { CALL Far [Dos21] ;Call orig. intr.     }
  129. { 34} $FB/               { STI              ;Enable interrupts.   }
  130. { 35} $9C/               { PUSHF            ;Save flags.          }
  131. { 36} $2E/               { CS:              ;                     }
  132. { 37} $FE/$0E/>UnSafe/   { DEC  [UnSafe]    ;Clear UnSafe flag.   }
  133. { 41} $9D/               { POPF             ;Restore flags.       }
  134. { 42} $CA/$02/$00/       { RETF 2           ;Return & remove flag.}
  135.  
  136. { 45} $9D/      {JmpDos21: POPF             ;Restore flags.       }
  137. { 46} $2E/               { CS:              ;                     }
  138. { 47} $FF/$2E/>Dos21/    { JMP Far [Dos21]  ;Jump to orig. intr.  }
  139. { 51}
  140. {*** OurIntr25 ********** Intercept routine For Dos Abs. Read *** }
  141. {  0} $9C/               { PUSHF            ;Save flags.          }
  142. {  1} $2E/               { CS:              ;                     }
  143. {  2} $FE/$06/>UnSafe/   { inC  [UnSafe]    ;Set UnSafe flag.     }
  144. {  6} $9D/               { POPF             ;Restore flags.       }
  145. {  7} $9C/               { PUSHF            ;                     }
  146. {  8} $2E/               { CS:              ;                     }
  147. {  9} $FF/$1E/>Dos25/    { CALL Far [Dos25] ;Call Dos abs. read.  }
  148. { 13} $68/>Our25+19/     { PUSH Our25+19    ;Clean up stack with- }
  149. { 16} $C2/$02/$00/       { RET  2           ;out changing flags.  }
  150. { 19} $9C/               { PUSHF            ;Save flags.          }
  151. { 20} $2E/               { CS:              ;                     }
  152. { 21} $FE/$0E/>UnSafe/   { DEC  [UnSafe]    ;Clear UnSafe flag.   }
  153. { 25} $9D/               { POPF             ;Restore flags.  Leave}
  154. { 26} $CB/               { RETF             ;old flags on the stk.}
  155. { 27}
  156. {*** OurIntr26 ********** Intercept routine For Dos Abs. Write ***}
  157. {  0} $9C/               { PUSHF            ;Save flags.          }
  158. {  1} $2E/               { CS:              ;                     }
  159. {  2} $FE/$06/>UnSafe/   { inC  [UnSafe]    ;Set UnSafe flag.     }
  160. {  6} $9D/               { POPF             ;Restore flags.       }
  161. {  7} $9C/               { PUSHF            ;                     }
  162. {  8} $2E/               { CS:              ;                     }
  163. {  9} $FF/$1E/>Dos26/    { CALL Far [Dos26] ;Call Dos abs. Write. }
  164. { 13} $68/>Our26+19/     { PUSH Our26+19    ;Clean up stack with- }
  165. { 16} $C2/$02/$00/       { RET  2           ;out changing flags.  }
  166. { 19} $9C/               { PUSHF            ;Save flags.          }
  167. { 20} $2E/               { CS:              ;                     }
  168. { 21} $FE/$0E/>UnSafe/   { DEC  [UnSafe]    ;Clear UnSafe flag.   }
  169. { 25} $9D/               { POPF             ;Restore flags.  Leave}
  170. { 26} $CB/               { RETF             ;old flags on the stk.}
  171. { 27}
  172.  
  173. {*** OurIntr9 ********** Intercept For BIOS Hardware Keyboard Intr}
  174. {  0} $9C/               { PUSHF            ;Entry point.         }
  175. {  1} $FB/               { STI              ;Enable interrupts.   }
  176. {  2} $1E/               { PUSH DS          ;                     }
  177. {  3} $0E/               { PUSH CS          ;DS := CS;            }
  178. {  4} $1F/               { POP  DS          ;                     }
  179. {  5} $50/               { PUSH AX          ;Preserve AX on stack.}
  180. {  6} $31/$C0/           { xor  AX,AX       ;Set AH to 0.         }
  181. {  8} $E4/$60/           { in   AL,60h      ;Read Byte from keybd }
  182. { 10} $3C/$E0/           { CMP  AL,0E0h     ;if multi-Byte codes, }
  183. { 12} $74/<75-14/        { JE   Sfx         ;then jump and set    }
  184. { 14} $3C/$F0/           { CMP  AL,0F0h     ;multi-Byte flag, Flg9}
  185. { 16} $74/<75-18/        { JE   Sfx         ;                     }
  186. { 18} $80/$3E/>Flg9/$00/ { CMP  [Flg9],0    ;Exit if part of      }
  187. { 23} $75/<77-25/        { JNZ  Cfx         ;multi-Byte code.     }
  188. { 25} $3A/$06/>Key/      { CMP  AL,[Key]    ;Exit if key pressed  }
  189. { 29} $75/<88-31/        { JNE  PreExit     ;is not hot key.      }
  190.  
  191. { 31} $50/               { PUSH AX          ;Hot key was pressed, }
  192. { 32} $06/               { PUSH ES          ;check shift key      }
  193. { 33} $B8/$40/$00/       { MOV  AX,0040h    ;status Byte.  First  }
  194. { 36} $8E/$C0/           { MOV  ES,AX       ;load BIOS segment.   }
  195. { 38} $26/               { ES:              ;                     }
  196. { 39} $A0/>$0017/        { MOV  AL,[0017h]  ;AL:= Shift key status}
  197. { 42} $07/               { POP  ES          ;Restore ES register. }
  198. { 43} $24/$0F/           { and  AL,0Fh      ;Clear unwanted bits. }
  199. { 45} $3A/$06/>Shft/     { CMP  AL,[Shft]   ;Exit if not hot key  }
  200. { 49} $58/               { POP  AX          ;shift key combination}
  201. { 50} $75/<88-52/        { JNE  PreExit     ;(Restore AX first).  }
  202.  
  203.                          {                  ;Hot Keys encountered.}
  204. { 52} $3A/$06/>Prev/     { CMP  AL,[Prev]   ;Discard Repeated hot }
  205. { 56} $74/<107-58/       { JE   Discard     ;key codes.           }
  206. { 58} $A2/>Prev/         { MOV  [Prev],AL   ;Update Prev.         }
  207. { 61} $F6/$06/>Flg/3/    { TEST [Flg],3     ;if Flg set, keep key }
  208. { 66} $75/<99-68/        { JNZ  JmpBios9    ;& Exit to orig. BIOS }
  209. { 68} $80/$0E/>Flg/1/    { or   [Flg],1     ;9.  else set flag and}
  210. { 73} $EB/<107-75/       { JMP SHorT Discard;discard key stroke.  }
  211.  
  212. { 75} $B4/$01/       {Sfx: MOV  AH,1        ;Load AH With set flag}
  213. { 77} $88/$26/>Flg9/ {Cfx: MOV  [Flg9],AH   ;Save multi-Byte flag.}
  214. { 81} $C6/$06/>Prev/$FF/ { MOV  [Prev],0FFh ;Change prev key Byte.}
  215. { 86} $EB/<99-88/        { JMP SHorT JmpBios9                     }
  216.  
  217. { 88} $3C/$FF/   {PreExit: CMP  AL,0FFh     ;Update previous key  }
  218. { 90} $74/<99-92/        { JE   JmpBios9    ;unless key is buffer-}
  219. { 92} $3C/$00/           { CMP  AL,0        ;full code--a 00h     }
  220. { 94} $74/<99-96/        { JZ   JmpBios9    ;0FFh                 }
  221. { 96} $A2/>Prev/         { MOV [Prev],AL    ;Update previous key. }
  222.  
  223. { 99} $58/      {JmpBios9: POP  AX          ;Restore Registers and}
  224. {100} $1F/               { POP  DS          ;flags.               }
  225. {101} $9D/               { POPF             ;                     }
  226. {102} $2E/               { CS:              ;                     }
  227. {103} $FF/$2E/>Bios9/    { JMP  [Bios9]     ;Exit to orig. intr 9.}
  228.  
  229. {107} $E4/$61/   {Discard: in   AL,61h      ;Clear key from buffer}
  230. {109} $8A/$E0/           { MOV  AH,AL       ;by resetting keyboard}
  231. {111} $0C/$80/           { or   AL,80h      ;port and sending EOI }
  232. {113} $E6/$61/           { OUT  61h,AL      ;to intr. handler     }
  233. {115} $86/$E0/           { XCHG AH,AL       ;telling it that the  }
  234. {117} $E6/$61/           { OUT  61h,AL      ;key has been         }
  235. {119} $B0/$20/           { MOV  AL,20h      ;processed.           }
  236. {121} $E6/$20/           { OUT  20h,AL      ;                     }
  237. {123} $58/               { POP  AX          ;Restore Registers and}
  238. {124} $1F/               { POP  DS          ;flags.               }
  239. {125} $9D/               { POPF             ;                     }
  240. {126} $CF/               { IRET             ;Return from interrupt}
  241. {127}
  242.  
  243. {*** OurIntr16 ***** Intercept routine For Buffered Keyboard Input}
  244. {  0} $58/     {JmpBios16: POP  AX          ;Restore AX, DS, and  }
  245. {  1} $1F/               { POP  DS          ;FLAGS Registers then }
  246. {  2} $9D/               { POPF             ;exit to orig. BIOS   }
  247. {  3} $2E/               { CS:              ;intr. 16h routine.   }
  248. {  4} $FF/$2E/>Bios16/   { JMP  [Bios16]    ;                     }
  249.  
  250. {  8} $9C/     {OurIntr16: PUSHF            ;Preserve FLAGS.      }
  251. {  9} $FB/               { STI              ;Enable interrupts.   }
  252. { 10} $1E/               { PUSH DS          ;Preserve DS and AX   }
  253. { 11} $50/               { PUSH AX          ;Registers.           }
  254. { 12} $0E/               { PUSH CS          ;DS := CS;            }
  255. { 13} $1F/               { POP  DS          ;                     }
  256. { 14} $F6/$C4/$EF/       { TEST AH,EFh      ;Jmp if not read Char.}
  257. { 17} $75/<48-19/        { JNZ  C3          ;request.             }
  258.  
  259.                          {*** Intercept loop For Read Key service.}
  260. { 19} $F6/$06/>Flg/1/ {C1: TEST [Flg],1     ;if pop up Flg bit is }
  261. { 24} $74/<29-26/        { JZ   C2          ;set then call Inline }
  262. { 26} $E8/>122-29/       { CALL toPopUp     ;pop up routine.      }
  263. { 29} $F6/$06/>Flg/16/{C2: TEST [Flg],10h   ;Jmp if insert flg set}
  264. { 34} $75/<48-36/        { JNZ  C3          ;                     }
  265. { 36} $FE/$C4/           { inC  AH          ;Use orig. BIOS       }
  266. { 38} $9C/               { PUSHF            ;service to check For }
  267. { 39} $FA/               { CLI              ;Character ready.     }
  268. { 40} $FF/$1E/>Bios16/   { CALL Far [Bios16];Disable interrupts.  }
  269. { 44} $58/               { POP  AX          ;Restore AX and save  }
  270. { 45} $50/               { PUSH AX          ;it again.            }
  271. { 46} $74/<19-48/        { JZ   C1          ;Loop Until chr. ready}
  272.  
  273. { 48} $F6/$06/>Flg/17/{C3: TEST [Flg],11h   ;Exit if neither bit  }
  274. { 53} $74/<-55/          { JZ   JmpBios16   ;of Flg is set.       }
  275. { 55} $F6/$06/>Flg/$01/  { TEST [Flg],1     ;if pop up Flg bit is }
  276. { 60} $74/<65-62/        { JZ   C4          ;set then call Inline }
  277. { 62} $E8/>122-65/       { CALL toPopUp     ;pop up routine.      }
  278. { 65} $F6/$06/>Flg/$10/{C4:TEST [Flg],10h   ;Exit unless have     }
  279. { 70} $74/<-72/          { JZ   JmpBios16   ;Characters to insert.}
  280. { 72} $F6/$C4/$EE/       { TEST AH,0EEh     ;if request is not a  }
  281. { 75} $75/<-77/          { JNZ  JmpBios16   ;chr. request, Exit.  }
  282.  
  283.                          {*** Insert a Character.                 }
  284. { 77} $58/               { POP  AX          ;AX := BIOS service no}
  285. { 78} $53/               { PUSH BX          ;Save BX and ES.      }
  286. { 79} $06/               { PUSH ES          ;                     }
  287. { 80} $C4/$1E/>InsChr/   { LES  BX,[InsChr] ;PTR(ES,BX) := InsChr;}
  288. { 84} $26/               { ES:              ;AL := InsChr^;       }
  289. { 85} $8A/$07/           { MOV  AL,[BX]     ;                     }
  290. { 87} $07/               { POP  ES          ;Restore ES and BX.   }
  291. { 88} $5B/               { POP  BX          ;                     }
  292. { 89} $F6/$C4/$01/       { TEST AH,01h      ;if AH in [$01,$11]   }
  293. { 92} $B4/$00/           { MOV  AH,00h      ;   then ReportOnly;  }
  294. { 94} $75/<114-96/       { JNZ  ReportOnly  ;Set Scan code to 0.  }
  295. { 96} $FE/$06/>InsChr/   { inC  [InsChr]    ;Inc( InsChr );       }
  296. {100} $FF/$0E/>InsNumb/  { DEC  [InsNumb]   ;Dec( InsNumb );      }
  297. {104} $75/<111-106/      { JNZ  SkipReset   ;if InsNumb = 0 then  }
  298. {106} $80/$26/>Flg/$EF/  { and  [Flg],0EFh  ; Clear insert chr flg}
  299. {111} $1F/     {SkipReset: POP  DS          ;Restore BX, DS, and  }
  300. {112} $9D/               { POPF             ;FLAGS, then return   }
  301. {113} $CF/               { IRET             ;from interrupt.      }
  302.  
  303. {114} $1F/    {ReportOnly: POP  DS          ;Report Char. ready.  }
  304. {115} $9D/               { POPF             ;Restore DS and FLAGS.}
  305. {116} $50/               { PUSH AX          ;Clear zero flag bit  }
  306. {117} $40/               { inC  AX          ;to indicate a        }
  307. {118} $58/               { POP  AX          ;Character ready.     }
  308. {119} $CA/>0002/         { RETF 2           ;Exit & discard FLAGS }
  309.  
  310.                          {*** Interface to PopUpCode Routine.     }
  311. {122} $50/       {toPopUp: PUSH AX          ;Save AX.             }
  312. {123} $FA/               { CLI              ;Disable interrupts.  }
  313. {124} $F6/$06/>UnSafe/$FF/{TEST [UnSafe],0FFh ;if UnSafe <> 0     }
  314. {129} $75/<177-131/      { JNZ  PP2           ;      then Return. }
  315. {131} $A0/>Flg/          { MOV  AL,[Flg]    ;Set in-use bit; clear}
  316. {134} $24/$FE/           { and  AL,0FEh     ;pop up bit of Flg.   }
  317. {136} $0C/$02/           { or   AL,2        ;Flg := (Flg and $FE) }
  318. {138} $A2/>Flg/          { MOV  [Flg],AL    ;        or 2;        }
  319.                          {                  ;**Switch to our stack}
  320. {141} $A1/>Stkofs/       { MOV  AX,[Stkofs] ;Load top of our stack}
  321. {144} $87/$C4/           { XCHG AX,SP       ;Exchange it With     }
  322. {146} $A3/>DosSp/        { MOV  [DosSp],AX  ;stk.ptr, save old SP.}
  323. {149} $8C/$16/>DosSs/    { MOV  [DosSs],SS  ;Save old SS.         }
  324. {153} $8E/$16/>StkSs/    { MOV  SS,[StkSs]  ;Replace SS With our  }
  325. {157} $FB/               { STI              ;SS. Enable interrupts}
  326.  
  327. {158} $9C/               { PUSHF            ;Interrupt call to pop}
  328. {159} $FF/$1E/>PopUp/    { CALL Far [PopUp] ;up TSR routine.      }
  329.  
  330. {163} $FA/               { CLI              ;Disable interrupts.  }
  331. {164} $8B/$26/>DosSp/    { MOV  SP,[DosSp]  ;Restore stack ptr    }
  332. {168} $8E/$16/>DosSs/    { MOV  SS,[DosSs]  ;SS:SP.  Clear in-use }
  333. {172} $80/$26/>Flg/$FD/  { and  [Flg],0FDh  ;bit of Flg.          }
  334.  
  335. {177} $FB/           {PP2: STI              ;Enable interrupts.   }
  336. {178} $58/               { POP  AX          ;Restore AX.          }
  337. {179} $C3 );             { RET              ;Return.              }
  338. {180}
  339. end; {Asm.} {end corresponds to 12 Bytes of code--used For storage}
  340.  
  341. Procedure PopUpCode; {Interface between the BIOS intercept        }
  342. INTERRUPT;           {routines and your TSR Function.             }
  343. Const  BSeg = $0040;   VBiosofs = $49;
  344. Type
  345.   VideoRecs = Record
  346.                 VideoMode                      : Byte;
  347.                 NumbCol, ScreenSize, Memoryofs : Word;
  348.                 CursorArea      : Array[0..7] of Word;
  349.                 CursorMode                     : Word;
  350.                 CurrentPage                    : Byte;
  351.                 VideoBoardAddr                 : Word;
  352.                 CurrentMode, CurrentColor      : Byte;
  353.               end;
  354. Var
  355.   Regs             : Registers;
  356.   VideoRec         : VideoRecs;
  357.   KeyLock          : Byte;
  358.   ScrnSeg, NumbChr : Word;
  359. begin
  360.   SwapVectors;                            {Set T.P. intr. vectors.}
  361.   Move( Ptr(BSeg,VBiosofs)^, VideoRec,    {Get Video BIOS info.   }
  362.         Sizeof(VideoRec) );
  363.   With VideoRec, Regs do begin
  364.     if (VideoMode > 7) or                  {Abort pop up if unable}
  365.        (ScreenSize > BuffSize) then begin  {to save screen image. }
  366.       SwapVectors;                         {Restore intr. vectors.}
  367.       Exit;
  368.     end;
  369.     KeyLock := Mem[BSeg:$0017];            {Save lock key states. }
  370.     if VideoMode = 7 then ScrnSeg := $B000 {Save screen--supports }
  371.     else ScrnSeg := $B800;                 {Text, MGA & CGA modes.}
  372.     Move( PTR( ScrnSeg, Memoryofs )^, Buffer, ScreenSize );
  373.     AX := InitVideo;                       {if in Graphics mode,  }
  374.     if (VideoMode >=4)                     {switch to Text mode.  }
  375.        and (VideoMode <= 6) then Intr( $10, Regs );
  376.     AX := $0500;                           {Select display page 0.}
  377.     Intr( $10, Regs );
  378.     CX := InitCMode;                       {Set cursor size.      }
  379.     AH := 1;
  380.     Intr( $10, Regs );
  381.  
  382.     TSRMode   := VideoMode;              {Fill global Variables   }
  383.     TSRWidth  := NumbCol;                {with current inFormation}
  384.     TSRPage   := CurrentPage;
  385.     TSRColumn := Succ( Lo( CursorArea[CurrentPage] ) );
  386.     TSRRow    := Succ( Hi( CursorArea[CurrentPage] ) );
  387.  
  388.     if NpxFlag then                      {Save co-processor state.}
  389.       Inline( $98/ $DD/$36/>NpxState );  {WAIT FSAVE [NpxState]   }
  390. {
  391. *** Call user's Program and save return code--no. Char. to insert.
  392. }
  393.     NumbChr := TheirFunc;
  394.     MemW[CSeg:InsNumb] := NumbChr;
  395.     if NumbChr > 0 then begin               {Have Char. to insert.}
  396.       MemL[CSeg:InsChr] := LongInt( TSRChrPtr );
  397.       Mem[CSeg:Flg]     := Mem[CSeg:Flg] or $10;
  398.     end;
  399. {
  400. *** Pop TSR back down--Restore Computer to previous state.
  401. }
  402.     if NpxFlag then                      {Restore co-prcssr state.}
  403.       Inline( $98/ $DD/$36/>NpxState );  {WAIT FSAVE [NpxState]   }
  404.  
  405.     Mem[BSeg:$17] :=                     {Restore key lock status.}
  406.       (Mem[BSeg:$17] and $0F) or (KeyLock and $F0);
  407.  
  408.     if Mem[BSeg:VBiosofs] <> VideoMode then begin
  409.       AX := VideoMode;                   {Restore video mode.     }
  410.       Intr( $10, Regs );
  411.     end;
  412.     AH := 1;  CX := CursorMode;          {Restore cursor size.    }
  413.     Intr( $10, Regs );
  414.     AH := 5;  AL := CurrentPage;         {Restore active page.    }
  415.     Intr( $10, Regs );
  416.     AH := 2;  BH := CurrentPage;         {Restore cursor positon. }
  417.     DX := CursorArea[CurrentPage];
  418.     Intr( $10, Regs );                   {Restore screen image.   }
  419.     Move( Buffer, PTR( ScrnSeg, Memoryofs )^, ScreenSize );
  420.  
  421.     SwapVectors;                        {Restore non-T.P. vectors.}
  422.   end;
  423. end;  {PopUp.}
  424. {
  425. ***** Printer Functions:
  426. }
  427. Function PrinterStatus: Byte;             {Returns status of LPT1.}
  428. { Definition of status Byte bits (1 & 2 are not used), if set then:
  429.  Bit: -- 7 ---  ---- 6 ----  -- 5 ---  -- 4 ---  -- 3 --  --- 0 ---
  430.       not busy  Acknowledge  No paper  Selected  I/O Err. Timed-out
  431. }
  432. Var Regs  : Registers;
  433. begin
  434.   With Regs do begin
  435.     AH := 2;  DX := 0;    {Load BIOS Function and Printer number. }
  436.     Intr( $17, Regs );    {Call BIOS Printer services.            }
  437.     PrinterStatus := AH;  {Return With Printer status Byte.       }
  438.   end;
  439. end; {PrinterStatus.}
  440.  
  441. Function PrinterOkay: Boolean;  {Returns True if Printer is okay. }
  442. Var  S : Byte;
  443. begin
  444.   S := PrinterStatus;
  445.   if ((S and $10) <> 0) and ((S and $29) = 0) then
  446.     PrinterOkay := True
  447.   else PrinterOkay := False;
  448. end;  {PrinterOkay.}
  449. {
  450. ***** Procedures to obtain contents of saved screen image.
  451. }
  452. Procedure ScreenLine( Row: Byte; Var Line: LineWords;
  453.                                  Var Words: Byte );
  454. begin
  455.   Words := 40;                        {Determine screen line size.}
  456.   if TSRMode > 1 then  Words := Words*2;          {Get line's     }
  457.   Move( Buffer[Pred(Row)*Words], Line, Words*2 ); {Characters and }
  458. end;  {ScreenLine.}                               {colors.        }
  459.  
  460. Function ScreenLineStr( Row: Byte ): String80; {Returns just Chars}
  461. Var
  462.   Words, i   : Byte;
  463.   LineWord   : LineWords;
  464.   Line       : String80;
  465. begin
  466.   ScreenLine( Row, LineWord, Words );   {Get Chars & attributes.  }
  467.   Line := '';                           {Move Characters to String}
  468.   For i := 1 to Words do Insert( LineWord[i].C, Line, i );
  469.   ScreenLineStr := Line;
  470. end;  {ScreenString.}
  471. {
  472. ***** TSR Installation Procedure.
  473. }
  474. Procedure TSRInstall( TSRName: String; TSRFunc: WordFuncs;
  475.                       ShiftComb: Byte; KeyChr: Char );
  476. Const
  477.   ScanChr = '+1234567890++++QWERTYUIOP++++ASDFGHJKL+++++ZXCVBNM';
  478.   CombChr = 'RLCA"';
  479. Var
  480.   PlistPtr         : ^String;
  481.   i, j, k          : Word;
  482.   Regs             : Registers;
  483.   Comb, ScanCode   : Byte;
  484. begin
  485.   if ofs( Asm1 ) <> 0 then Exit;           {offset of Asm must be 0}
  486.   MemW[CSeg:StkSs]  := SSeg;              {Save Pointer to top of }
  487.   MemW[CSeg:Stkofs] := Sptr + 562;        {TSR's stack.           }
  488.   MemL[CSeg:PopUp]  := LongInt(@PopUpCode); {Save PopUpCode addr. }
  489.   TheirFunc         := TSRFunc;           {& their TSR func. addr.}
  490.   Writeln('Installing Stay-Resident Program: ',TSRName );
  491. {
  492. *****  Save intercepted interrupt vectors: $09, $16, $21, $25, $26.
  493. }
  494.   GetIntVec( $09, Pointer( MemL[CSeg:Bios9] ) );
  495.   GetIntVec( $16, Pointer( MemL[CSeg:Bios16] ) );
  496.   GetIntVec( $21, Pointer( MemL[CSeg:Dos21] ) );
  497.   GetIntVec( $25, Pointer( MemL[CSeg:Dos25] ) );
  498.   GetIntVec( $26, Pointer( MemL[CSeg:Dos26] ) );
  499. {
  500. ***** Get equipment list and video mode.
  501. }
  502.   With Regs do begin
  503.     Intr( $11, Regs );                  {Check equipment list For }
  504.     NpxFlag := (AL and 2) = 2;          {math co-processor.       }
  505.     AH      := 15;                      {Get current video mode   }
  506.     Intr( $10, Regs );                  {and save it For when TSR }
  507.     InitVideo := AL;                    {is activated.            }
  508.     AH := 3; BH := 0;                   {Get current cursor size  }
  509.     Intr( $10, Regs );                  {and save it For when TSR }
  510.     InitCMode := CX;                    {is activated.            }
  511.   end;  {WITH Regs}
  512. {
  513. ***** Get info. on buffer For saving screen image.
  514. }
  515.   BuffSize := Sizeof( Buffer );
  516.   TSRScrPtr := @Buffer;
  517. {
  518. *** Determine activation key combination.
  519. }
  520.   Comb := 0;  i := 1;                       {Create ptr to        }
  521.   PlistPtr := Ptr( PrefixSeg, $80 );        {parameter list.      }
  522.   While i < Length( PlistPtr^ ) do begin    {Check For parameters.}
  523.     if PlistPtr^[i] = '/' then begin        {Process parameter.   }
  524.       Inc( i );
  525.       j := Pos( UpCase( PlistPtr^[i] ), CombChr );
  526.       if (j > 0) and (j < 5) then Comb := Comb or (1 SHL Pred(j))
  527.       else if j <> 0 then begin             {New activation Char. }
  528.         Inc( i );   k := Succ( i );
  529.         if i > Length(PlistPtr^) then KeyChr := #0
  530.         else begin
  531.           if ((k <= Length(PlistPtr^)) and (PlistPtr^[k] = '"'))
  532.              or (PlistPtr^[i] <> '"') then KeyChr := PlistPtr^[i]
  533.           else KeyChr := #0;
  534.         end;  {else begin}
  535.       end;  {else if ... begin}
  536.     end; {if PlistPtr^[i] = '/'}
  537.     Inc( i );
  538.   end;  {While ...}
  539.   if Comb = 0 then Comb := ShiftComb;  {Use default combination.  }
  540.   if Comb = 0 then Comb := AltKey;     {No default, use [Alt] key.}
  541.   ScanCode := Pos( UpCase( KeyChr ), ScanChr );  {Convert Char. to}
  542.   if ScanCode < 2 then begin                     {scan code.      }
  543.     ScanCode := 2;  KeyChr := '1';
  544.   end;
  545.   Mem[CSeg:Shft] := Comb;             {Store shift key combination}
  546.   Mem[CSeg:Key]  := ScanCode;         {and scan code.             }
  547. {
  548. *** Output an installation message:  Memory used & activation code.
  549. }
  550.   {Writeln( 'Memory used is approximately ',
  551.    ( ($1000 + Seg(FreePtr^) - PrefixSeg)/64.0):7:1,' K (K=1024).');
  552.   }Writeln(
  553. 'Activate Program by pressing the following keys simultaneously:');
  554.   if (Comb and 1) <> 0 then Write(' [Right Shift]');
  555.   if (Comb and 2) <> 0 then Write(' [Left Shift]');
  556.   if (Comb and 4) <> 0 then Write(' [Ctrl]');
  557.   if (Comb and 8) <> 0 then Write(' [Alt]');
  558.   Writeln(' and "', KeyChr, '".');
  559. {
  560. *** Intercept orig. interrupt vectors; then Exit and stay-resident.
  561. }
  562.   SetIntVec( $21, Ptr( CSeg, Our21 ) );
  563.   SetIntVec( $25, Ptr( CSeg, Our25 ) );
  564.   SetIntVec( $26, Ptr( CSeg, Our26 ) );
  565.   SetIntVec( $16, Ptr( CSeg, Our16 ) );
  566.   SetIntVec( $09, Ptr( CSeg, Our09 ) );
  567.   SwapVectors;                           {Save turbo intr.vectors.}
  568.   MemW[CSeg:UnSafe] := 0;                {Allow TSR to pop up.    }
  569.   Keep( 0 );                             {Exit and stay-resident. }
  570. end;  {TSRInstall.}
  571. end.  {TSRUnit.}
  572.  
  573.  
  574. Program TSRDemo;  {An example TSR Program created using TSRUnit.   }
  575.  
  576. {$M $0800,0,0}   {Set stack and heap size For demo Program.        }
  577.  
  578. Uses Crt, Dos, TSRUnit; {Specify the TSRUnit in the Uses statement.}
  579.                         {Do not use the Printer Unit, instead treat}
  580.                         {the Printer like a File; i.e. use the     }
  581.                         {Assign, ReWrite, and Close Procedures.    }
  582.  
  583. Const  DemoPgmName : String[16] = 'TSR Demo Program';
  584.  
  585. Var
  586.   Lst      : Text;      {Define Variable name For the Printer.     }
  587.   TextFile : Text;      {  "        "     "    "   a data File.    }
  588.   InsStr   : String;    {Storage For Characters to be inserted into}
  589.                         {keyboard input stream--must be a gobal or }
  590.                         {heap Variable.                            }
  591.  
  592. Function IOError: Boolean;    {Provides a message when an I/O error}
  593. Var  i : Word;                {occurs.                             }
  594. begin
  595.   i       := Ioresult;
  596.   IOError := False;
  597.   if i <> 0 then begin
  598.     Writeln('I/O Error No. ',i);
  599.     IOError := True;
  600.   end;
  601. end;  {OurIoresult.}
  602. {
  603. ***** Demo routine to be called when TSRDemo is popped up.
  604.       be Compiled as a Far Function that returns a Word containing
  605.       the number of Characters to insert into the keyboard input
  606.       stream.
  607. }
  608. {$F+} Function DemoTasks: Word; {$F-}
  609. Const
  610.   FileName : String[13] = ' :TSRDemo.Dat';
  611.   endPos = 40;
  612.   Wx1 = 15; Wy1 = 2;   Wx2 = 65; Wy2 = 23;
  613. Var
  614.   Key, Drv          : Char;
  615.   Done, IOErr       : Boolean;
  616.   InputPos, RowNumb : Integer;
  617.   DosVer            : Word;
  618.   InputString       : String;
  619.  
  620.   Procedure ClearLine; {Clears current line and resets line Pointer}
  621.   begin
  622.     InputString := '';     InputPos := 1;
  623.     GotoXY( 1, WhereY );   ClrEol;
  624.   end;
  625.  
  626. begin
  627.   DemoTasks   := 0;             {Default to 0 Characters to insert.}
  628.   Window( Wx1, Wy1, Wx2, Wy2 ); {Set up the screen display.        }
  629.   TextColor( Black );
  630.   TextBackground( LightGray );
  631.   LowVideo;
  632.   ClrScr;                      {Display initial messages.          }
  633.   Writeln;
  634.   Writeln('  Example Terminate & Stay-Resident (TSR) Program');
  635.   Writeln(' --written With Turbo Pascal 5.0 and Uses TSRUnit.');
  636.   Window( Wx1+1, Wy1+4, Wx2-1, Wy1+12);
  637.   TextColor( LightGray );
  638.   TextBackground( Black );
  639.   ClrScr;                      {Display Function key definitions.  }
  640.   Writeln;
  641.   Writeln('    Function key definitions:');
  642.   Writeln('        [F1]  Write message to TSRDEMO.DAT');
  643.   Writeln('        [F2]    "     "     to Printer.');
  644.   Writeln('        [F3]  Read from saved screen.');
  645.   Writeln('        [F8]  Exit and insert Text.');
  646.   Writeln('        [F10] Exit TSR and keep it.');
  647.   Write(  '        or simply echo your input.');
  648.  
  649.                                {Create active display Window.      }
  650.   Window( Wx1+1, Wy1+14, Wx2-1, Wy2-1 );
  651.   ClrScr;
  652.                                {Display system inFormation.        }
  653.   Writeln('TSRUnit Version: ', Hi(TSRVersion):8, '.',
  654.                                Lo(TSRVersion):2 );
  655.   Writeln('Video Mode, Page:', TSRMode:4, TSRPage:4 );
  656.   Writeln('Cursor Row, Col.:', TSRRow:4, TSRColumn:4 );
  657.  
  658.   DosVer := DosVersion;
  659.   Writeln('Dos Version:     ', Lo(DosVer):8, '.', Hi(DosVer):2 );
  660.  
  661.   InputString := '';          {Initialize Variables.               }
  662.   InputPos    := 1;
  663.   Done        := False;
  664.  
  665.   Repeat                      {Loop For processing keystrokes.     }
  666.     GotoXY( InputPos, WhereY );    {Move cursor to input position. }
  667.     Key := ReadKey;                {Wait For a key to be pressed.  }
  668.     if Key = #0 then begin         {Check For a special key.       }
  669.       Key := ReadKey;              {if a special key, get auxiliary}
  670.       Case Key of                  {Byte to identify key pressed.  }
  671.  
  672. {Cursor Keys and simple editor.}
  673. {Home}  #71: InputPos := 1;
  674. {Right} #75: if InputPos > 1 then Dec( InputPos );
  675. {Left}  #77: if (InputPos < Length( InputString ))
  676.                 or ((InputPos = Length( InputString ))
  677.                     and (InputPos < endPos )) then Inc( InputPos );
  678. {end}   #79: begin
  679.                InputPos := Succ( Length( InputString ) );
  680.                if InputPos > endPos then InputPos := endPos;
  681.              end;
  682. {Del}   #83: begin
  683.                Delete( InputString, InputPos, 1 );
  684.                Write( Copy( InputString, InputPos, endPos ), ' ');
  685.              end;
  686.  
  687. {Function Keys--TSRDemo's special features.}
  688. {F1}    #59: begin                 {Write short message to a File. }
  689.                ClearLine;
  690.                Repeat
  691.                  Write('Enter disk drive:  ',FileName[1] );
  692.                  Drv := UpCase( ReadKey );  Writeln;
  693.                  if Drv <> #13 then FileName[1] := Drv;
  694.                  Writeln('Specifying an invalid drive will cause your');
  695.                  Write('system to crash.  Use drive ',
  696.                         FileName[1], ': ?  [y/N] ');
  697.                  Key := UpCase( ReadKey );  Writeln( Key );
  698.                Until Key = 'Y';
  699.                Writeln('Writing to ',FileName );
  700.                {$I-}                         {Disable I/O checking.}
  701.                Assign( TextFile, 'TSRDemo.Dat' );
  702.                if not IOError then begin     {Check For error.     }
  703.                  ReWrite( TextFile );
  704.                  if not IOError then begin
  705.                    Writeln(TextFile,'File was written by TSRDemo.');
  706.                    IOErr := IOError;
  707.                    Close( TextFile );
  708.                    IOErr := IOError;
  709.                  end;
  710.                end;
  711.                {$I+}                 {Enable standard I/O checking.}
  712.                Writeln('Completed File operation.');
  713.              end;  {F1}
  714.  
  715. {F2}    #60: begin {Print a message, use TSRUnit's auxiliary       }
  716.                    {Function PrinterOkay to check Printer status.  }
  717.                ClearLine;
  718.                Writeln('Check Printer status, then print if okay.');
  719.                if PrinterOkay then begin  {Check if Printer is okay}
  720.                  Assign( Lst, 'LPT1' );   {Define Printer device.  }
  721.                  ReWrite( Lst );          {Open Printer.           }
  722.                  Writeln( Lst, 'Printing perFormed from TSRDemo');
  723.                  Close( Lst );            {Close Printer.          }
  724.                end
  725.                else Writeln('Printer is not ready.');
  726.                Writeln( 'Completed print operation.' );
  727.              end;  {F2}
  728.  
  729. {F3}    #61: begin {Display a line from the saved screen image--not}
  730.                    {valid if the TSR was popped up While the       }
  731.                    {display was in a Graphics mode.                }
  732.                ClearLine;
  733.                Case TSRMode of    {Check video mode of saved image.}
  734.                  0..3,
  735.                  7: begin
  736.                       {$I-}
  737.                       Repeat
  738.                         Writeln('Enter row number [1-25] from ');
  739.                         Write('which to copy Characters:  ');
  740.                         Readln( RowNumb );
  741.                       Until not IOError;
  742.                       {$I+}
  743.                       if RowNumb <= 0 then RowNumb := 1;
  744.                       if RowNumb > 25 then RowNumb := 25;
  745.                       Writeln( ScreenLineStr( RowNumb ) );
  746.                     end;
  747.                else Writeln('not valid For Graphics modes.');
  748.                end;  {Case TSRMode}
  749.              end;  {F3}
  750. {F8}    #66: begin {Exit and insert String into keyboard buffer.}
  751.                ClearLine;
  752.                Writeln('Enter Characters to insert;');
  753.                Writeln('Up to 255 Character may be inserted.');
  754.                Writeln('Terminate input String by pressing [F8].');
  755.                InsStr := '';
  756.                Repeat                     {Insert Characters into a}
  757.                  Key := ReadKey;          {Until [F8] is pressed.  }
  758.                  if Key = #0 then begin     {Check For special key.}
  759.                    Key := ReadKey;          {Check if key is [F8]. }
  760.                    if Key = #66 then Done := True; {[F8] so done.  }
  761.                  end
  762.                  else begin {not special key, add it to the String.}
  763.                    if Length(InsStr) < Pred(Sizeof(InsStr)) then
  764.                    begin
  765.                      if Key = #13 then Writeln
  766.                      else Write( Key );
  767.                      InsStr := InsStr + Key;
  768.                    end
  769.                    else Done := True; {Exceeded Character limit.   }
  770.                  end;
  771.                Until Done;
  772.                DemoTasks := Length( InsStr );  {Return no. of chr. }
  773.                TSRChrPtr := @InsStr[1];        {Set ptr to 1st chr.}
  774.              end;  {F8}
  775.  
  776. {F10}   #68: Done := True; {Exit and Stay-Resident.                }
  777.  
  778.       end;  {Case Key}
  779.     end  {if Key = #0}
  780.     else begin   {Key pressed was not a special key--just echo it. }
  781.       Case Key of
  782. {BS}    #08: begin  {Backspace}
  783.                if InputPos > 1 then begin
  784.                  Dec( InputPos );
  785.                  Delete( InputString, InputPos, 1 );
  786.                  GotoXY( InputPos, WhereY );
  787.                  Write( Copy( InputString, InputPos, endPos ), ' ');
  788.                end;
  789.              end;  {BS}
  790. {CR}    #13: begin  {Enter}
  791.                Writeln;
  792.                InputString := '';
  793.                InputPos    := 1;
  794.              end;  {CR}
  795. {Esc}   #27: ClearLine;
  796.       else
  797.         if Length( InputString ) >= endPos then
  798.           Delete( InputString, endPos, 1 );
  799.         Insert( Key, InputString, InputPos );
  800.         Write( Copy( InputString, InputPos, endPos ) );
  801.         if InputPos < endPos then
  802.           Inc( InputPos );
  803.       end;  {Case...}
  804.     end;  {else begin--Key <> #0}
  805.     Until Done;
  806. end;  {DemoTasks.}
  807.  
  808. begin
  809.   TSRInstall( DemoPgmName, DemoTasks, AltKey, 'E' );
  810. end.  {TSRDemo.}
  811.  
  812.  
  813.